home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
objtba.zip
/
MMGRRPTS.DOC
< prev
next >
Wrap
Text File
|
1993-01-04
|
43KB
|
1,339 lines
MMGRRPTS.PAS LISTING PAGE 1
UNIT MMgrRpts;
{ This unit is the Report generation Unit that supports MMGR.PAS.
It exists to modularize the program and allow for main program
code of more than the 65K limit imposed by the TP IDE editor.
It utilizes routines from both ObjectBase and ObjectInterFace to
generate the reports and interact with the user. }
INTERFACE
USES Dos,
Crt,
Utility, { ObjectInterFace - Various general purpose routines }
{ and interfaces to help system }
MMgrVar, { Global Variable declarations for MMGR.PAS }
Forms, { ObjectInterFace - Form Object Definition }
Fields, { ObjectInterFace - Field Object Definitions }
Windows, { ObjectInterFace - Windows and Menu Definitions }
UserIO, { ObjectInterFace - General User Input Output routines }
DBObjt, { ObjectBase - Lowleve File routines for use by }
{ OopBase Unit }
OopBase; { ObjectBase - Contains DB Object Definitions }
Procedure MailLabels;
Procedure ContactReports;
Procedure CompanyReports;
IMPLEMENTATION
function checkforprinter:boolean;
{ This routine is here for your use. It informs the user if his printer
is not contected to the computer or is turned off. EPSON Specific. }
var rgs : registers;
begin
with rgs do
begin
AX := $0200;
DX := $0000;
end;
intr($17,Rgs);
CheckForPrinter := not ((Rgs.AH and $C8 = $C8) or (Rgs.AH and $30 = $30));
end;
Procedure MailLabels;
var ch : char; { Dummy variable to receive a keypress so it will be removed
from keyboard buffer. }
Procedure ContLabel;
{ Handles Person Based Label generation }
label NoPrint;
var OldDataFile,
OldNdxFile,
FileName: FName;
LabelDefaults : Form;
LftMrgn,
RghtMrgn,
MMGRRPTS.PAS LISTING PAGE 2
TopMrgn,
FilterCode,
PageLength : integer;
Device: text;
Tfile: oopfile;
truncate : Boolean;
ch : char;
function PassesFilter(c : PersonType; code: integer): Boolean;
{ simple filter routine for Person based label routine }
var passed : Boolean; { temparary variable }
begin
Passed := true;
Case Code of
2 : begin { flagged records only }
passed := c.flag;
end;
3 : begin { unflagged records only }
passed := not c.flag;
end;
end;
PassesFilter := Passed;
end;
Procedure PrintPersonLabel;
{ Prints the Actual label }
Function FormName(L,F,M:string):string;
{ Formats firstname, lastname, middlename fields into an
acceptable format for a label }
Var Temp: String;
Begin
Trim(L); { Removes trailing blanks from string variable }
Trim(F); { part of ObjectInterFaces general Routines }
Trim(M);
Case F[0] of
#0 : F := ''; { Empty }
#1 : F := Concat(F,'. '); { Initial - add '. ' }
Else F := Concat(F,' '); { Normal - add space}
End;
Case M[0] of
#0 : M := ''; { Empty }
#1 : M := Concat(M,'. '); { Initial - add '. ' }
else M := Concat(M,' '); { Normal - add space}
end;
Temp := concat(F,M,L);
FormName := Temp;
end;
begin {PrintPersonLabel}
PLine := 1; { Global variable in Utiliy Unit }
while PLine <= topmrgn do
println(device,0,''); { ObjectBase - keeps track of print }
MMGRRPTS.PAS LISTING PAGE 3
{ head location print line }
PrintLn(device,LftMrgn,
FormName(Person.LName,Person.FName,Person.MName));
if Truncate then
PrintLn(device,LftMrgn,copy(Company.name,1,rghtmrgn-lftmrgn))
else
PrintLn(device,LftMrgn,Company.Name);
PrintLn(device,LftMrgn,Company.addr1);
if company.addr2[0] > #0 then
PrintLn(device,LftMrgn,Company.addr2);
println(device,LftMrgn,concat(trimmed(company.city),', ',Company.st,
' ', Company.Zip));
while Pline <= Pagelength do PrintLn(device,0,'');
end;
Procedure TestPrint;
{ Prints a Sample label until position is accepted by user }
Var Choice : Boolean;
Begin
Choice := False;
PushHelp(Ord(TestPrintHelp));
Repeat
PLine := 1;
while PLine <= topmrgn do
println(device,0,'');
{ Printat() Allows you to format printer data similar to screen }
{ if column location requested is less than the current column }
{ a linefeed is generated and print head is moved to column }
{ location requested and data is printed on device. PLine is }
{ handled as expected. (ObjectInterFace Routine) }
Printat(device,LftMrgn,rpt('*',RghtMrgn-LftMrgn));
if Truncate then
Printat(device,LftMrgn,rpt('*',RghtMrgn-LftMrgn))
else
Printat(device,LftMrgn,rpt('*',sizeof(Company.name)-1));
Printat(device,LftMrgn,rpt('*',sizeof(Company.addr1)-1));
Printat(device,LftMrgn,rpt('*',sizeof(Company.addr1)-1));
println(device,LftMrgn,concat(rpt('*',sizeof(company.city)-1),
', ',rpt('*',sizeof(Company.st)-1),
' ', rpt('*',sizeof(Company.Zip)-1)));
while Pline <= Pagelength do PrintLn(device,0,'');
choice := yesno('Is the Label print in the correct position?');
Until choice;
PopHelp;
end;
var TestValue,
DvcCode : integer;
m,mf : MenuArray; { Defined in WINDOWS Unit - ObjectInterFace }
ScrnBuf : Pointer; { if report sent to screen, must put screen }
{ somewhere. }
w : WindowRecord; { Defined in WINDOWS Unit - ObjectInterFace }
Begin
MMGRRPTS.PAS LISTING PAGE 4
FillChar(M,SizeOf(M),#0);
WITH M DO
BEGIN
Size := 3;
Txt[ 0] := 'DESTINATION';
Txt[ 1] := ' Screen';
Txt[ 2] := ' Printer';
Txt[ 3] := ' File';
END;
FillChar(Mf,SizeOf(Mf),#0);
WITH Mf DO
BEGIN
Size := 3;
Txt[ 0] := 'SELECTION';
Txt[ 1] := ' All';
Txt[ 2] := ' Selected';
Txt[ 3] := ' Unselected';
END;
testValue := 3;
LabelDefaults.init(10,8,45,14,2,' Label Defaults ',
' <Ctrl Z> Exits Form ');
with LabelDefaults do { Objects are similar to Records }
begin
Load(new(PckFldPtr,init(21,2,10,m,'Destination:',@DvcCode)));
{ Conditional field - Only appears if DvcCode = TestValue }
Load(new(CndFldPtr,init(@DvcCode,intgr,@TestValue,new(strFldPtr,
init(21,3,20,'FileName:','Enter File Name',
Rpt('!',20),@FileName)))));
Load(new(PckFldPtr,init(21,5,10,mf,'Selection:',@FilterCode)));
load(new(intFldPtr,init(30,7,3,0,65,'TopMargin(Lines):',
@TopMrgn)));
load(new(intfldPtr,init(30,8,3,0,65,'PageLength(Lines):',
@pagelength)));
load(new(IntFldPtr,Init(30,9,3,0,132,'LeftMargin(Chars):',
@LftMrgn)));
load(new(IntFldPtr,Init(30,10,3,0,132,'RightMargin(Chars):',
@RghtMrgn)));
end;
Pushhelp(Ord(ReportFormhelp));
DvcCode := 2;
FileName := 'MAILLBLS.TXT';
TopMrgn := 1;
RghtMrgn := 35;
LftMrgn := 2;
Pagelength := 6;
FilterCode := 1;
Labeldefaults.edit;
labeldefaults.leave;
Truncate := ((RghtMrgn - LftMrgn) < (Sizeof(Company.Name)-1));
{ LabelDefaults only gets FileName if Device code points to Disk File }
Case DvcCode of
1 : FileName := 'CON';
2 : begin
FileName := 'PRN';
if not checkforprinter then
begin
MMGRRPTS.PAS LISTING PAGE 5
noprintermsg.show;
ch := readkey;
noprintermsg.hide;
goto noprint;
end;
end;
end;
assign(device,filename);
rewrite(device);
if FileName = 'PRN' then
begin
SetPrinterMsg.show;
ch := readKey;
SetPrinterMsg.hide;
PrintingMsg.show;
testprint;
end
else if FileName = 'CON' then
begin
getmem(ScrnBuf,80*50);
savewindow(w);
save_scrn_Rgn(1,1,80,25,ScrnBuf);
clrscr;
end;
with dbase do
begin
LoadRelation( PersonData,ContactData,ContactPrsnAccess,
@Person.Code);
LoadRelation( ContactData,CompanyData,CompanySysNdx,
@Contact.CompanyCode);
Switchto(PersonData);
SetIndex(PersonUserNdx);
Clear;
Next;
Associate(PersonData);
end;
While Not dbase.EoFile do
begin
If passesfilter(Person,FilterCode) then printPersonlabel;
dbase.next;
DBase.Associate(PersonData);
end;
If passesfilter(Person,FilterCode) then printPersonlabel;
if FileName = 'CON' then
begin
Gotoxy(1,25);
Write('Strike a Key to Continue...');
ch := Readkey;
Restore_Scrn_Rgn(1,1,80,25,ScrnBuf);
RestoreWindow(W);
Freemem(ScrnBuf,80*25*2);
end;
Close(Device);
NoPrint:
DBase.ClearRelations;
PrintingMsg.Hide;
MMGRRPTS.PAS LISTING PAGE 6
LabelDeFaults.done;
PopHelp;
End;
Procedure CompanyLabel;
label noprint;
var OldDataFile,
OldNdxFile,
FileName: FName;
LabelDefaults : Form;
LftMrgn,
RghtMrgn,
TopMrgn,
FilterCode,
PageLength : integer;
Device: text;
Tfile: oopfile;
truncate : Boolean;
ch : char;
function PassesFilter(c : CompanyType; code: integer): Boolean;
var passed : Boolean;
begin
Passed := true;
Case Code of
2 : begin { flagged records only }
passed := c.flag;
end;
3 : begin { unflagged records only }
passed := not c.flag;
end;
end;
PassesFilter := Passed;
end;
procedure printCompanyLabel;
begin
PLine := 1;
while PLine <= topmrgn do
println(device,0,'');
if Truncate then
PrintLn(device,LftMrgn,copy(Company.name,1,rghtmrgn-lftmrgn))
else
PrintLn(device,LftMrgn,Company.Name);
PrintLn(device,LftMrgn,Company.addr1);
if company.addr2[0] > #0 then
PrintLn(device,LftMrgn,Company.addr2);
println(device,LftMrgn,concat(trimmed(company.city),', ',Company.st,
' ', Company.Zip));
while Pline <= Pagelength do PrintLn(device,0,'');
end;
procedure testprint;
MMGRRPTS.PAS LISTING PAGE 7
var choice : boolean;
begin
Choice := False;
PushHelp(ord(TestPrintHelp));
Repeat
PLine := 1;
while PLine <= topmrgn do
println(device,0,'');
if Truncate then
Printat(device,LftMrgn,rpt('*',RghtMrgn-LftMrgn))
else
Printat(device,LftMrgn,rpt('*',sizeof(Company.name)-1));
Printat(device,LftMrgn,rpt('*',sizeof(Company.addr1)-1));
Printat(device,LftMrgn,rpt('*',sizeof(Company.addr1)-1));
println(device,LftMrgn,concat(rpt('*',sizeof(company.city)-1),
', ',rpt('*',sizeof(Company.st)-1),
' ', rpt('*',sizeof(Company.Zip)-1)));
while Pline <= Pagelength do PrintLn(device,0,'');
choice := yesno('Is the Label print in the correct position?');
Until choice;
PopHelp;
end;
var TestValue,
DvcCode : integer;
m,mf : MenuArray;
ScrnBuf : Pointer;
w : WindowRecord;
Begin
FillChar(M,SizeOf(M),#0);
WITH M DO
BEGIN
Size := 3;
Txt[ 0] := 'DESTINATION';
Txt[ 1] := ' Screen';
Txt[ 2] := ' Printer';
Txt[ 3] := ' File';
END;
FillChar(Mf,SizeOf(Mf),#0);
WITH Mf DO
BEGIN
Size := 3;
Txt[ 0] := 'SELECTION';
Txt[ 1] := ' All';
Txt[ 2] := ' Flagged';
Txt[ 3] := ' Unflagged';
END;
testValue := 3;
LabelDefaults.init(10,8,45,14,2,' Label Defaults ','');
with LabelDefaults do
begin
Load(new(PckFldPtr,init(21,2,10,m,'Destination:',@DvcCode)));
Load(new(CndFldPtr,init(@DvcCode,intgr,@TestValue,new(strFldPtr,
MMGRRPTS.PAS LISTING PAGE 8
init(21,3,20,'FileName:','Enter File Name',
Rpt('!',20),@FileName)))));
Load(new(PckFldPtr,init(21,5,10,mf,'Selection:',@FilterCode)));
load(new(intFldPtr,init(30,7,3,0,65,'TopMargin(Lines):',
@TopMrgn)));
load(new(intfldPtr,init(30,8,3,0,65,'PageLength(Lines):',
@pagelength)));
load(new(IntFldPtr,Init(30,9,3,0,132,'LeftMargin(Chars):',
@LftMrgn)));
load(new(IntFldPtr,Init(30,10,3,0,132,'RightMargin(Chars):',
@RghtMrgn)));
end;
Truncate := ((RghtMrgn - LftMrgn) < (Sizeof(Company.Name)-1));
DvcCode := 2;
FileName := 'MAILLBLS.TXT';
TopMrgn := 1;
RghtMrgn := 35;
LftMrgn := 2;
Pagelength := 6;
FilterCode := 1;
PushHelp(Ord(ReportFormHelp));
Labeldefaults.edit;
labeldefaults.leave;
Case DvcCode of
1 : FileName := 'CON';
2 : begin
FileName := 'PRN';
if not checkforprinter then
begin
noprintermsg.show;
ch := readkey;
noprintermsg.hide;
goto noprint;
end;
end;
end;
assign(device,filename);
rewrite(device);
if FileName = 'PRN' then
begin
SetPrinterMsg.show;
ch := readKey;
SetPrinterMsg.hide;
PrintingMsg.show;
testprint;
end
else if FileName = 'CON' then
begin
getmem(ScrnBuf,80*50);
savewindow(w);
save_scrn_Rgn(1,1,80,25,ScrnBuf);
clrscr;
end;
with dbase do
begin
SwitchTo(CompanyData);
MMGRRPTS.PAS LISTING PAGE 9
SetIndex(CompanyUserNdx);
Clear;
Next;
end;
While Not dbase.EoFile do
begin
If passesfilter(Company,FilterCode) then printcompanylabel;
dbase.next;
end;
If passesfilter(Company,FilterCode) then printcompanylabel;
if FileName = 'CON' then
begin
Gotoxy(1,25);
Write('Strike a Key to Continue...');
ch := Readkey;
Restore_Scrn_Rgn(1,1,80,25,ScrnBuf);
RestoreWindow(W);
Freemem(ScrnBuf,80*25*2);
end;
PrintingMsg.Hide;
Close(Device);
NoPrint:
LabelDeFaults.done;
PopHelp;
End;
var
choice : integer;
Finished : Boolean;
begin
pushhelp(ord(labelhelp));
Finished := False;
Repeat
Choice := labelsMenu.Pop;
LabelsMenu.Leave;
CASE Choice of
1 : contlabel;
2 : Companylabel;
3 : Finished := True;
End;
Until Finished;
LabelsMenu.Hide;
pophelp;
end;
Procedure comp_W_Contacts;
label NoPrint;
var
choice : integer;
ch : char;
Another_Contact : Boolean;
Title,
Device,
OldCode : string;
delimstrt,
delimfnsh : string[2];
MMGRRPTS.PAS LISTING PAGE 10
Dest : Text;
scrn : array[1..2000] of word;
w : windowrecord;
i,
colpos,
tfiletype,
PageNo,
PageLength : integer;
m : menuarray;
fn : form;
Procedure DispCwCntBlock;
Procedure DispContact;
begin
PrintAt(Dest,LeftMargin+31,
concat(trimmed(person.LName),', ',trimmed(person.FName),' ',
trimmed(person.MName)));
Printat(Dest,RightMargin-sizeof(Contact.Position),
concat(delimstrt,Trimmed(Contact.Position),delimfnsh));
end;
begin
another_contact := True;
{ print next PLine }
IF (PLine >= PageLength - BottomMargin) and (PageLength > -1) then
begin
{ Print Header }
if PageNo > 0 then formfeed(Dest,Device);
PLine := 0;
While PLine < TopMargin do
PrintLn(Dest,0,'');
Inc(PageNo);
PrintAt(Dest,LeftMargin,DateStr(Today,mmddyyyy));
PrintAt(Dest,((RightMargin-Length(title)) div 2), Title);
PrintLn(dest,RightMargin-8,concat('Page ',i_str(PageNo,3)));
PrintLn(Dest,0,'');
PrintAt(dest,LeftMargin,'COMPANY');
PrintLn(Dest,LeftMargin+31,
'CONTACT');
PrintLn(dest,LeftMargin, rpt('-',RightMargin-LeftMargin));
end;
{ Print company name }
Printat(Dest,LeftMargin,copy(Company.Name,1,28));
{ Print contact name and position }
DispContact;
DBase.NextAssoc(CompanyData);
if OldCode = Person.Code then another_Contact := False;
{ NewLine }
println(dest,0,'');
{ Print Company address 1 }
Printat(Dest,LeftMargin,Company.Addr1);
If another_contact then
begin
DispContact;
DBase.NextAssoc(CompanyData);
MMGRRPTS.PAS LISTING PAGE 11
if OldCode = Person.Code then another_Contact := False;
end;
{ NewLine }
println(dest,0,'');
If Company.addr2 <> '' then
begin
Printat(Dest,LeftMargin,Company.Addr2);
If another_contact then
begin
DispContact;
DBase.NextAssoc(CompanyData);
if OldCode = Person.Code then another_Contact := False;
end;
{ NewLine }
println(dest,0,'');
end;
{ print company city st zip }
Printat(Dest,LeftMargin,
concat(Company.City,', ',Company.St,' ',
Formatted(ZipMask,Company.zip)));
If another_contact then
begin
DispContact;
DBase.NextAssoc(CompanyData);
if OldCode = Person.Code then another_Contact := False;
end;
println(Dest,0,'');
{ Print company Phone }
PrintAt(Dest,LeftMargin,
formatted(phnMask,company.phone));
While another_contact do
begin
DispContact;
DBase.NextAssoc(CompanyData);
if OldCode = Person.Code then another_Contact := False;
end;
{ NewLine }
println(dest,0,'');
println(dest,0,'');
end;
Procedure PrintCwCntBlock;
procedure PrintContact;
begin
If another_contact then
begin
PrintAt(Dest,LeftMargin+SizeOf(Company.Name)+Length(PhnMask)+1,
concat(person.LName,', ',person.FName,' ',person.MName));
Printat(Dest,RightMargin-sizeof(Contact.Position),
concat(delimstrt,Trimmed(Contact.Position),delimfnsh));
DBase.NextAssoc(CompanyData);
if OldCode = Person.Code then another_Contact := False;
end;
end;
MMGRRPTS.PAS LISTING PAGE 12
begin
another_contact := True;
{ print next PLine }
IF (PLine >= PageLength - BottomMargin) and (PageLength > -1) then
begin
{ Print Header }
if PageNo > 0 then formfeed(Dest,Device);
PLine := 0;
While PLine < TopMargin do
PrintLn(Dest,0,'');
Inc(PageNo);
PrintAt(Dest,LeftMargin,DateStr(Today,mmddyyyy));
PrintAt(Dest,((RightMargin-Length(title)) div 2), Title);
PrintLn(dest,RightMargin-8,concat('Page ',i_str(PageNo,3)));
PrintLn(Dest,0,'');
PrintAt(dest,LeftMargin,'COMPANY');
PrintAt(Dest,LeftMargin+SizeOf(Company.Name),'PHONE');
PrintAt(Dest,LeftMargin+SizeOf(Company.Name)+Length(PhnMask)+1,
'CONTACT');
PrintLn(Dest,RightMargin-sizeof(Contact.Position),'POSITION');
PrintLn(dest,LeftMargin, rpt('-',RightMargin-LeftMargin));
end;
{ Print company name }
Printat(Dest,LeftMargin,Company.Name);
{ Print company Phone }
PrintAt(Dest,LeftMargin+SizeOf(Company.Name),
formatted(phnMask,company.phone));
{ Print contact name and position }
PrintContact;
{ NewLine }
println(dest,0,'');
{ Print Company address 1 }
Printat(Dest,LeftMargin,Company.Addr1);
PrintContact;
{ NewLine }
println(dest,0,'');
If Company.addr2 <> '' then
begin
Printat(Dest,LeftMargin,Company.Addr2);
printcontact;
{ NewLine }
println(dest,0,'');
end;
{ print company city st zip }
Printat(Dest,LeftMargin,
concat(Company.City,', ',Company.St,' ',
Formatted(ZipMask,Company.zip)));
while another_contact do PrintContact;
{ NewLine }
println(dest,0,'');
println(dest,0,'');
end;
begin
another_Contact := true;
MMGRRPTS.PAS LISTING PAGE 13
pushhelp(ord(reporthelp));
Choice := DeviceMenu.Pop;
delimstrt := '';
delimfnsh := '';
tfiletype := 0;
DeviceMenu.Hide;
CASE Choice of
1 : begin
Device := 'CON';
LeftMargin := 0;
rightmargin := 79;
topmargin := 0;
Bottommargin:= 4;
pagelength := 24;
savewindow(w);
save_Scrn_Rgn(1,1,80,25,@scrn);
clrscr;
end;
2 : begin
Device := 'PRN';
if not checkforprinter then
begin
noprintermsg.show;
ch := readkey;
noprintermsg.hide;
goto noprint;
end;
LeftMargin := 5;
RightMargin := 120;
topmargin := 2;
Bottommargin:= 7;
PageLength := 66;
SetPrinterMsg.show;
ch := readKey;
SetPrinterMsg.hide;
PrintingMsg.show;
end;
3 : begin
Device := 'REPORT.PRN';
fn.init(20,8,40,6,QueryBorder,' FILE NAME ','');
fn.Load(new(strfldptr,init(13,2,25,'Path + Name:',
'Enter Path & Name of File',rpt('!',25),@Device)));
fn.edit;
fn.hide;
fn.done;
delimstrt := '';
delimfnsh := '';
LeftMargin := 5;
RightMargin := 125;
topmargin := 2;
Bottommargin:= 7;
PageLength := 66;
ff := concat(#12);
PrintingMsg.show;
end;
4 : begin
MMGRRPTS.PAS LISTING PAGE 14
PopHelp;
exit;
end;
End;
assign(Dest,device);
rewrite(dest);
PLine := PageLength + 1;
if device = 'PRN' then write(Dest,#15);
PCol := 0;
DBase.LoadRelation( CompanyData,ContactData,ContactCompAccess,
@Company.Code);
DBase.loadRelation( ContactData,PersonData,PersonSysNdx,
@Contact.personCode);
DBase.Switchto(CompanyData);
DBase.SetIndex(CompanyUserNdx);
dbase.top;
DBase.Associate(CompanyData);
OldCode := Person.Code;
Title := '**** C O M P A N Y L I S T I N G ****';
PageNo := 0;
while Not DBase.EoFile DO
begin
if Device = 'CON' then
DispCwCntBlock
else
PrintCwCntBlock;
DBase.Next;
DBase.Associate(CompanyData);
OldCode := Person.Code;
end;
if Device = 'CON' then
DispCwCntBlock
else
PrintCwCntBlock;
{ NewLine }
println(dest,0,'');
formfeed(dest,Device);
if Device = 'CON'then
begin
restore_Scrn_Rgn(1,1,80,25,@scrn);
RestoreWindow(w);
end
else
printingmsg.hide;
close(dest);
DBase.ClearRelations;
Noprint:
pophelp;
end;
Procedure Comp_WO_Contacts;
var
FileName: FName;
LabelDefaults : Form;
LftMrgn,
MMGRRPTS.PAS LISTING PAGE 15
RghtMrgn,
BtmMrgn,
TopMrgn,
PageNo,
FilterCode,
PageLength : integer;
Title : String;
Device: text;
ToPrint: Boolean;
function PassesFilter(c : CompanyType; code: integer): Boolean;
var passed : Boolean;
begin
Passed := true;
Case Code of
2 : begin { flagged records only }
passed := c.flag;
end;
3 : begin { unflagged records only }
passed := not c.flag;
end;
end;
PassesFilter := Passed;
end;
procedure NewPage;
VAR CH: CHAR;
begin
if ToPrint then
begin
if PageNo > 0 then formfeed(Device,FileName);
PLine := 0;
While PLine < TopMrgn do
PrintLn(Device,0,'');
Inc(PageNo);
PrintAt(Device,LftMrgn,DateStr(Today,mmddyyyy));
PrintAt(Device,((RghtMrgn-Length(title)) div 2), Title);
PrintLn(Device,RghtMrgn-8,concat('Page ',i_str(PageNo,3)));
PrintLn(Device,0,'');
PrintAt(Device,LftMrgn,'COMPANY NAME');
PrintAt(Device,LftMrgn+SizeOf(Company.Name),'ADDRESS');
PrintAt(Device,LftMrgn+SizeOf(Company.Name) + SizeOf(Company.Addr1),
'CITY / ST / ZIP');
PrintLn(Device,LftMrgn,'PHONE');
PrintLn(Device,LftMrgn, rpt('-',RghtMrgn-LftMrgn));
end
else
begin
If PageNo > 0 then
begin
GotoXY(1,25);
Write('Press any Key to Continue...');
ch := ReadKey;
clrscr;
end;
MMGRRPTS.PAS LISTING PAGE 16
PLine := 0;
Inc(PageNo);
PrintAt(Device,LftMrgn,DateStr(Today,mmddyyyy));
PrintAt(Device,((RghtMrgn-Length(title)) div 2), Title);
PrintLn(Device,RghtMrgn-8,concat('Page ',i_str(PageNo,3)));
PrintLn(Device,0,'');
PrintAt(Device,LftMrgn,'COMPANY NAME');
Println(Device,LftMrgn+SizeOf(Company.Name),'CITY');
PrintAt(Device,LftMrgn,'ADDRESS');
Println(Device,LftMrgn+SizeOf(Company.Name),'STATE / ZIP');
PrintLn(Device,LftMrgn+SizeOf(Company.Name),'PHONE');
PrintLn(Device,LftMrgn, rpt('-',RghtMrgn-LftMrgn));
end;
end;
procedure PrintCompanyLine;
begin
if toPrint then
begin
if PLine > PageLength - BtmMrgn then newpage;
Printat(device,LftMrgn,Company.name);
Printat(device,LftMrgn+sizeof(company.name),Company.addr1);
Printat(device,LftMrgn+Sizeof(Company.name)+sizeof(company.addr1),
concat(trimmed(company.city),', ',
company.st,' ',trimmed(company.zip)));
printat(device,LftMrgn,formatted('(999)999-99999',company.phone));
Printat(device,LftMrgn+sizeof(company.name),Company.addr2);
end
else
begin
if PLine > PageLength - BtmMrgn then newpage;
Printat(device,LftMrgn,Company.name);
PrintLn(device,LftMrgn+sizeof(company.name),Company.City);
Printat(device,LftMrgn,Company.addr1);
PrintLn(device,LftMrgn+sizeof(company.name),concat(Company.St,
' ',Company.zip));
Printat(device,LftMrgn,Company.Addr2);
printLn(device,LftMrgn+sizeof(company.name),
formatted('(999)999-99999',company.phone));
PrintLn(Device,0,'');
end;
end;
label noprint;
var TestValue,
DvcCode : integer;
m,mf : MenuArray;
ch : Char;
ScrnBuf : Pointer;
w : WindowRecord;
Begin
FillChar(M,SizeOf(M),#0);
WITH M DO
BEGIN
MMGRRPTS.PAS LISTING PAGE 17
Size := 3;
Txt[ 0] := 'DESTINATION';
Txt[ 1] := ' Screen';
Txt[ 2] := ' Printer';
Txt[ 3] := ' File';
END;
FillChar(Mf,SizeOf(Mf),#0);
WITH Mf DO
BEGIN
Size := 3;
Txt[ 0] := 'SELECTION';
Txt[ 1] := ' All';
Txt[ 2] := ' Flagged';
Txt[ 3] := ' Unflagged';
END;
testValue := 3;
LabelDefaults.init(10,8,45,14,2,' Label Defaults ','');
with LabelDefaults do
begin
Load(new(PckFldPtr,init(21,2,10,m,'Destination:',@DvcCode)));
Load(new(CndFldPtr,init(@DvcCode,intgr,@TestValue,new(strFldPtr,
init(21,3,20,'FileName:','Enter File Name',
Rpt('!',20),@FileName)))));
Load(new(PckFldPtr,init(21,5,10,mf,'Selection:',@FilterCode)));
load(new(intFldPtr,init(30,7,3,0,5,'TopMargin(Lines):',
@TopMrgn)));
load(new(intfldPtr,init(30,8,3,0,66,'PageLength(Lines):',
@pagelength)));
load(new(IntFldPtr,Init(30,9,3,0,132,'Line Width(Chars):',
@RghtMrgn)));
end;
PushHelp(Ord(ReportFormHelp));
DvcCode := 2;
FileName := 'COMPRPT.TXT';
BtmMrgn := 3;
PageNo := 0;
TopMrgn := 1;
RghtMrgn := 80;
LftMrgn := 5;
Pagelength := 66;
FilterCode := 1;
Title := '*** C O M P A N Y L I S T ***';
ToPrint := True;
Labeldefaults.edit;
labeldefaults.leave;
Case DvcCode of
1 : begin
FileName := 'CON';
end;
2 : Begin
FileName := 'PRN';
if not checkforprinter then
begin
noprintermsg.show;
ch := readkey;
noprintermsg.hide;
MMGRRPTS.PAS LISTING PAGE 18
goto noprint;
end;
end;
end;
assign(device,filename);
rewrite(device);
if FileName = 'PRN' then
begin
SetPrinterMsg.show;
ch := readKey;
SetPrinterMsg.hide;
PrintingMsg.show;
if rghtmrgn < 120 then
BEGIN
RGHTMRGN := LftMrgn + SizeOf(Company.Name) +
SizeOf(Company.addr1) + SizeOf(Company.St) +
SizeOf(Company.City) + SizeOf(Company.Zip) + 4;
write(device,#15);
END;
end
else if FileName = 'CON' then
begin
getmem(ScrnBuf,80*50);
savewindow(w);
save_scrn_Rgn(1,1,80,25,ScrnBuf);
clrscr;
LftMrgn := 0;
RghtMrgn := 79;
PageLength := 24;
BtmMrgn := 2;
ToPrint := False;
end;
with dbase do
begin
SwitchTo(CompanyData);
SetIndex(CompanyUserNdx);
Clear;
Next;
end;
Pline := PageLength +1;
While Not dbase.EoFile do
begin
If passesfilter(Company,FilterCode) then PrintCompanyLine;
dbase.next;
end;
If passesfilter(Company,FilterCode) then PrintCompanyLine;
if FileName = 'CON' then
begin
Gotoxy(1,25);
Write('Strike a Key to Continue...');
ch := Readkey;
Restore_Scrn_Rgn(1,1,80,25,ScrnBuf);
RestoreWindow(W);
Freemem(ScrnBuf,80*25*2);
end
else formfeed(device,filename);
MMGRRPTS.PAS LISTING PAGE 19
PrintingMsg.Hide;
close(Device);
NoPrint:
LabelDeFaults.done;
PopHelp;
end;
Procedure CompanyReports;
var ch : char;
choice : integer;
Finished : Boolean;
begin
pushhelp(ord(reporthelp));
Finished := False;
Repeat
Choice := CompLstMenu.Pop;
CompLstMenu.Leave;
CASE Choice of
1 : begin
comp_W_Contacts;
end;
2 : begin
comp_WO_Contacts
end;
3 : Finished := True;
End;
Until Finished;
CompLstMenu.Hide;
pophelp;
end;
Procedure ContactReports;
Label NoPrint;
var
choice : integer;
ch : char;
NewPerson : Boolean;
Title,
Device,
OldCode : string;
delimstrt,
delimfnsh : string[2];
Dest : Text;
scrn : array[1..2000] of word;
w : windowrecord;
i,
colpos,
tfiletype,
PageNo,
PageLength : integer;
m : menuarray;
fn : form;
begin
MMGRRPTS.PAS LISTING PAGE 20
pushhelp(ord(reporthelp));
Choice := DeviceMenu.Pop;
delimstrt := '';
delimfnsh := '';
tfiletype := 0;
DeviceMenu.Hide;
CASE Choice of
1 : begin
Device := 'CON';
LeftMargin := 0;
rightmargin := 79;
topmargin := 0;
Bottommargin:= 0;
pagelength := 24;
savewindow(w);
save_Scrn_Rgn(1,1,80,25,@scrn);
clrscr;
end;
2 : begin
Device := 'PRN';
if not checkforprinter then
begin
noprintermsg.show;
ch := readkey;
noprintermsg.hide;
goto noprint;
end;
LeftMargin := 1;
RightMargin := 79;
topmargin := 2;
Bottommargin:= 2;
PageLength := 66;
SetPrinterMsg.show;
ch := readKey;
SetPrinterMsg.hide;
PrintingMsg.show;
end;
3 : begin
Device := 'REPORT.PRN';
fn.init(20,8,40,7,QueryBorder,' FILE NAME ','');
fn.load(new(StrFldPtr,init(11,2,25,'FileName:',
'Enter path & file to save report to ...',rpt('!',25),@Device)));
WITH M DO
BEGIN
Size := 4;
Txt[ 0] := 'SELECT';
Txt[ 1] := ' 1 Print File';
Txt[ 2] := ' 2 Comma Delimited';
Txt[ 3] := ' 3 Quote Delimited';
Txt[ 4] := ' 4 Quote+Comma';
END;
fn.load(new(PckFldPtr,init(11,3,15,m,'Format:',@tfiletype)));
fn.edit;
fn.hide;
fn.done;
Case tfileType of
MMGRRPTS.PAS LISTING PAGE 21
1 : begin
delimstrt := '';
delimfnsh := '';
LeftMargin := 1;
RightMargin := 79;
topmargin := 2;
Bottommargin:= 2;
PageLength := 66;
ff := concat(#12);
end;
2 : begin
delimstrt := '';
delimfnsh := ',';
LeftMargin := 0;
RightMargin := 0;
topmargin := 0;
Bottommargin:= -1;
PageLength := -1;
ff := '';
end;
3 : begin
delimstrt := '"';
delimfnsh := '"';
LeftMargin := 0;
RightMargin := 0;
topmargin := 0;
Bottommargin:= -1;
PageLength := -1;
ff := '';
end;
4 : begin
delimstrt := '"';
delimfnsh := '",';
LeftMargin := 0;
RightMargin := 0;
topmargin := 0;
Bottommargin:= -1;
PageLength := -1;
ff := '';
end;
end;
PrintingMsg.show;
end;
4 : begin
PopHelp;
exit;
end;
End;
assign(Dest,device);
rewrite(dest);
PLine := PageLength + 1;
PCol := 0;
DBase.LoadRelation( PersonData,ContactData,ContactPrsnAccess,
@Person.Code);
DBase.loadRelation( ContactData,CompanyData,CompanySysNdx,
@Contact.CompanyCode);
MMGRRPTS.PAS LISTING PAGE 22
DBase.Switchto(PersonData);
DBase.SetIndex(PersonUserNdx);
dbase.top;
DBase.Associate(PersonData);
OldCode := Company.Code;
Title := '**** C O N T A C T L I S T ****';
PageNo := 0;
NewPerson := True;
while NOT DBase.EoFile DO
begin
{ print next PLine }
IF (PLine >= PageLength - BottomMargin) and (PageLength > -1) then
begin
{ Print Header }
if PageNo > 0 then formfeed(Dest,Device);
PLine := 0;
While PLine < TopMargin do
PrintLn(Dest,0,'');
Inc(PageNo);
PrintAt(Dest,LeftMargin,DateStr(Today,mmddyyyy));
PrintAt(Dest,((RightMargin-Length(title)) div 2), Title);
PrintLn(dest,RightMargin-8,concat('Page ',i_str(PageNo,3)));
PrintLn(Dest,0,'');
PrintAt(dest,LeftMargin,'CONTACT');
PrintAt(Dest,LeftMargin+25,'COMPANY');
PrintLn(Dest,RightMargin-sizeof(Contact.Position),'POSITION');
PrintLn(dest,LeftMargin, rpt('-',RightMargin-LeftMargin));
end;
If (NewPerson) or (PageLength = -1) then
Printat(Dest,Leftmargin,concat(DelimStrt,Trimmed(Person.LName),', ',
Trimmed(Person.FName),' ',Trimmed(Person.MName),Delimfnsh));
if tfiletype>1 then colpos := 0 else colpos := 25;
Printat(Dest,LeftMargin+colpos,concat(delimstrt,Company.Name,delimfnsh));
Printat(Dest,RightMargin-sizeof(Contact.Position),
concat(delimstrt,Trimmed(Contact.Position),delimfnsh));
println(dest,0,'');
{ reset data }
NewPerson := False;
DBase.NextAssoc(PersonData);
if Company.Code = OldCode then
begin
DBase.Next;
DBase.Associate(PersonData);
OldCode := Company.Code;
NewPerson := True;
end;
end;
If (NewPerson) or (PageLength = -1) then
Printat(Dest,Leftmargin,concat(DelimStrt,Trimmed(Person.LName),', ',
Trimmed(Person.FName),' ',Trimmed(Person.MName),Delimfnsh));
if tfiletype>1 then colpos := 0 else colpos := 25;
Printat(Dest,LeftMargin+colpos,concat(delimstrt,Company.Name,delimfnsh));
Printat(Dest,RightMargin-sizeof(Contact.Position),
concat(delimstrt,Trimmed(Contact.Position),delimfnsh));
println(dest,0,'');
formfeed(dest,Device);
MMGRRPTS.PAS LISTING PAGE 23
if Device = 'CON'then
begin
restore_Scrn_Rgn(1,1,80,25,@scrn);
RestoreWindow(w);
end
else
printingmsg.hide;
close(dest);
DBase.ClearRelations;
NoPrint:
pophelp;
end;
end. { Unit MMgrRpts }